home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #2 / Monster Media No. 2 (Monster Media)(1994).ISO / clipper / output.zip / OUTPUTM.PRG < prev    next >
Text File  |  1994-07-16  |  7KB  |  256 lines
  1. /*
  2.  * File......: OUTPUTM.PRG
  3.  * Author....: Berend M. Tober
  4.  * CIS ID....: 70541,1030
  5.  * Date......: $Date$
  6.  * Revision..: $Revision$
  7.  * Log file..: $Logfile$
  8.  * 
  9.  * This is an original work by Berend M. Tober and is placed in the
  10.  * public domain.
  11.  *
  12.  * Modification history:
  13.  * ---------------------
  14.  *
  15.  * $Log$
  16.  *
  17.  */
  18.  
  19. /*  $DOC$
  20.  *  $FUNCNAME$
  21.  *     FT_OUTPUTM()
  22.  *  $CATEGORY$
  23.  *     To be assigned
  24.  *  $ONELINER$
  25.  *     Sends reports to screen/file/printer
  26.  *  $SYNTAX$
  27.  *     FT_OUTPUTM( <bReport>, [<cColors>] ) -> NIL
  28.  *  $ARGUMENTS$
  29.  *     <bReport>  - Codeblock which calls your function to perform
  30.  *                  report.
  31.  *     <cColors>  - Color string for destination menu.
  32.  *  $RETURNS$
  33.  *     NIL
  34.  *  $DESCRIPTION$
  35.  *     |--------------------------------------------------------------|
  36.  *     This module is useful when you wish to create applications that
  37.  *     produce reports and you wish to optionally send those reports
  38.  *     to the screen, a disk file, or the printer.
  39.  *
  40.  *     FT_OUTPUTM pops up an screen-centered ACHOICE menu listing the
  41.  *     three ouput destinations.  Depending on the user's selection
  42.  *     ouput produced by the call to your report (via the codeblock)
  43.  *     is sent to different places.
  44.  *  $EXAMPLES$
  45.  *
  46.  *     // As a funtion call
  47.  *     lFinished := FT_OUTPUTM()
  48.  *
  49.  *  $SEEALSO$
  50.  *  $INCLUDE$
  51.  *     box.ch
  52.  *     inkey.ch
  53.  *     common.ch
  54.  *     outputm.ch
  55.  *     setcurs.ch
  56.  *  $END$
  57.  *
  58.  */
  59.  
  60. #include "box.ch"
  61. #include "inkey.ch"
  62. #include "common.ch"
  63. #include "setcurs.ch"
  64.  
  65. /*
  66. // File:    OUTPUTM.CH   // Command for FT_OUTPUTM()
  67. // Author:  Berend M. Tober
  68. // Date:    1994/07/12
  69. #ifndef _OUTPUTM_CH
  70.  
  71.    #xcommand OUTPUTM BLOCK <b> [COLORS <c>] TO <r>;
  72.              => <r> := FT_OUTPUTM(  <b>, <c> )
  73.  
  74.    #xcommand OUTPUTM BLOCK <b> [COLORS <c>] ;
  75.              => FT_OUTPUTM(  <b>, <c> )
  76.  
  77.    #define _OUTPUTM_CH
  78.  
  79. #endif
  80. */
  81.  
  82. ANNOUNCE CLIPPER501
  83.  
  84. #ifdef FT_TEST
  85.  
  86. #include "outputm.ch"
  87. PROCEDURE T_OUTPUTM    // Sample program
  88.    * Example #1 - Command invocation
  89.    OUTPUTM BLOCK {||Report1()}
  90.  
  91.    * Example #2 - Function call invocation
  92.    ft_outputm({||Report2()})
  93.    RETURN
  94.  
  95. STATIC FUNCTION Report1()
  96.    @ 1,0 SAY "SAMPLE REPORT #1"
  97.    @ 3,0 SAY "The OUTPUTM command really provides a substantial"
  98.    @ 4,0 SAY "amount of flexibilily in how you use it."
  99.    ?
  100.    RETURN ALERT("Done")
  101.  
  102. STATIC FUNCTION Report2()
  103.    @ 1,0 SAY "SAMPLE REPORT #2"
  104.    @ 3,0 SAY "These two examples, however, were trivial..."
  105.    RETURN ALERT("Done")
  106.  
  107. #endif
  108.  
  109. ********************************* FT_OUTPUTM() *********************************
  110. FUNCTION FT_OUTPUTM( bReport, cColors )
  111.    * Prompts user for output destination of report information
  112.  
  113.    LOCAL nCursor  := SETCURSOR( SC_NONE )
  114.    LOCAL cHeader  := "Select output destination..."
  115.    LOCAL cFooter  := "Press <ESC> to exit"
  116.    LOCAL nChoice  := 0
  117.  
  118.    LOCAL aMenuItems :=;
  119.    {;
  120.    "Screen"    ,;
  121.    "Disk File" ,;
  122.    "Printer"    ;
  123.    }
  124.  
  125.    LOCAL aMenuBlocks :=;
  126.    {;
  127.    {|| _ftToSCR( bReport )},;
  128.    {|| _ftToFIL( bReport )},;
  129.    {|| _ftToPRN( bReport )} ;
  130.    }
  131.  
  132.    // Center menu on screen
  133.    LOCAL nHigh := LEN( aMenuItems )
  134.    LOCAL nWide := MAX(11,MAX(LEN(cHeader),LEN(cFooter)))
  135.    LOCAL nBoxT := INT((MAXROW()-nHigh)/2)
  136.    LOCAL nBoxL := INT((MAXCOL()-nWide)/2)
  137.    LOCAL nBoxB := nBoxT + nHigh + 1
  138.    LOCAL nBoxR := nBoxl + nWide + 1
  139.  
  140.    DEFAULT bReport TO {|| TRUE }
  141.    DEFAULT cColors TO SETCOLOR("N/W, W/N")
  142.  
  143.    @ nBoxT-2, nBoxL+0, nBoxT+0, nBoxR BOX B_SINGLE
  144.    @ nBoxB+0, nBoxL+0, nBoxB+2, nBoxR BOX B_SINGLE
  145.  
  146.    @ nBoxT-1, nBoxL+1 SAY PADC(cHeader, nWide )
  147.    @ nBoxB+1, nBoxL+1 SAY PADC(cFooter, nWide )
  148.    @ nBoxT++, nBoxL++, nBoxB--, nBoxR-- BOX "├─┤│┤─├│ "
  149.  
  150.    nChoice := ACHOICE( nBoxT, nBoxL, nBoxB, nBoxR, aMenuItems )
  151.  
  152.    IF nChoice != 0
  153.       EVAL( aMenuBlocks[nChoice] )
  154.    ENDIF
  155.  
  156.    SETCURSOR( nCursor )
  157.    SETCOLOR( cColors )
  158.    RETURN NIL
  159. *  end of FT_OUTPUTM()
  160.  
  161. ************************** STATIC FUNCTION _ftToSCR() **************************
  162. STATIC FUNCTION _ftToSCR( bReport )
  163.    * Sends report info to console
  164.    LOCAL lBlink   := SETBLINK( .F. )
  165.    LOCAL cColor   := SETCOLOR("N/W*")
  166.    LOCAL nBoxT    := 0, nBoxL := 0, nBoxB := MAXROW(), nBoxR := MAXCOL()
  167.    LOCAL cMsg     := "Use arrow keys to navigate.  <ESC> to quit"
  168.    LOCAL cFile    := FT_TEMPFIL(".\")
  169.  
  170.    SET CONSOLE OFF
  171.    SET PRINTER TO (cFile)
  172.    SET PRINTER ON
  173.    SET DEVICE TO PRINTER
  174.  
  175.    EVAL( bReport )
  176.  
  177.    cFile := SET(_SET_PRINTFILE)
  178.    SET DEVICE TO SCREEN
  179.    SET PRINTER TO
  180.    SET PRINTER OFF
  181.    SET CONSOLE ON
  182.  
  183.    DISPBOX( nBoxT++, nBoxL++, nBoxB--, nBoxR--, SPACE(8), "W/B")
  184.    DISPBOX( nBoxT--, nBoxL++, nBoxB++, nBoxR--,   SPACE(9), "N/W*")
  185.    @ nBoxB, nBoxL SAY PADC(cMsg, nBoxR )  COLOR "W/B"
  186.  
  187.    MEMOEDIT(MEMOREAD(cFile), ++nBoxT, nBoxL, --nBoxB, nBoxR, .F.)
  188.    ERASE (cFile)
  189.  
  190.    SETCOLOR( cColor )
  191.    SETBLINK( lBlink )
  192.  
  193.    RETURN NIL
  194. *  end of STATIC FUNCTION _ftToSCR()
  195.  
  196. ************************** STATIC FUNCTION _ftToFIL() **************************
  197. STATIC FUNCTION _ftToFIL( bReport )
  198.    * Sends report info to file
  199.    #define MSG_FILENAME "Enter destination file name: "
  200.    LOCAL cFile    := SPACE(32)
  201.    LOCAL nHigh    := 1
  202.    LOCAL nWide    := LEN(MSG_FILENAME+cFile)+2
  203.    LOCAL nBoxT    := INT((MAXROW()-nHigh)/2)
  204.    LOCAL nBoxL    := INT((MAXCOL()-nWide)/2)
  205.    LOCAL nBoxB    := nBoxT + nHigh + 1
  206.    LOCAL nBoxR    := nBoxl + nWide + 1
  207.    LOCAL GetList  := {}
  208.  
  209.    DO WHILE ( ALLTRIM(cFile) == "" ) .AND. ( LASTKEY() != K_ESC )
  210.       DISPBOX( nBoxT++, nBoxL++, nBoxB--, nBoxR--, B_SINGLE+" ")
  211.       @ nBoxB, nBoxL SAY MSG_FILENAME GET cFile
  212.       READ
  213.    ENDDO
  214.    IF LASTKEY() <> K_ESC
  215.       cFile := ALLTRIM( cFile )
  216.  
  217.       SET CONSOLE OFF
  218.       SET PRINTER TO (cFile)
  219.       SET PRINTER ON
  220.       SET DEVICE TO PRINTER
  221.  
  222.       EVAL( bReport )
  223.  
  224.       SET DEVICE TO SCREEN
  225.       SET PRINTER TO
  226.       SET PRINTER OFF
  227.       SET CONSOLE ON
  228.  
  229.       ALERT("Application printed to file "+cFile)
  230.    ENDIF
  231.    RETURN NIL
  232. *  end of STATIC FUNCTION _ftToFIL()
  233.  
  234. ************************** STATIC FUNCTION _ftToPRN() **************************
  235. STATIC FUNCTION _ftToPRN( bReport )
  236.    * Sends report info to printer
  237.  
  238.    SET CONSOLE OFF
  239.    SET PRINTER ON
  240.    SET PRINTER TO
  241.    SET DEVICE TO PRINTER
  242.    DO WHILE (LASTKEY(0) <> K_ESC) .AND. !ISPRINTER()
  243.       ALERT("PRINTER NOT READY")
  244.    ENDDO
  245.    IF LASTKEY() <> K_ESC
  246.       EVAL( bReport )
  247.       EJECT
  248.       ALERT("Done")
  249.    ENDIF
  250.    SET CONSOLE ON
  251.    SET PRINTER OFF
  252.    SET DEVICE TO SCREEN
  253.    RETURN NIL
  254. *  end of STATIC FUNCTION _ftToPRN()
  255.  
  256.